home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / shazam.exe / GUNSORT.IMP < prev    next >
Encoding:
Text File  |  1992-09-01  |  5.7 KB  |  188 lines
  1.    {*******************************************************************
  2.  
  3.    GUNSORT.IMP
  4.  
  5.    *******************************************************************}
  6.    {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
  7.  
  8.    METHODS - UNSORTED STRING COLLECTION
  9.  
  10.    |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  11.    {===================================================================
  12.  
  13.    FREE ITEM
  14.  
  15.    ===================================================================}
  16. procedure TUnsortedCollection.FreeItem ( Item : pointer ) ; 
  17. begin
  18.    DisposeStr ( Item ) ;
  19. end ;
  20.    {===================================================================
  21.  
  22.    PUT ITEM
  23.  
  24.    ===================================================================}
  25. procedure TUnsortedCollection.PutItem ( VAR S : TStream ; Item : Pointer ) ;
  26. begin
  27.    S.WriteStr ( Item ) ;
  28. end ;
  29.    {===================================================================
  30.  
  31.    GET ITEM
  32.  
  33.    ===================================================================}
  34. function TUnsortedCollection.GetItem ( VAR S : TStream ) : Pointer ;
  35. begin
  36.    GetItem                   := S.ReadStr ;
  37. end ;
  38.    {===================================================================
  39.  
  40.    LOAD
  41.  
  42.    ===================================================================}
  43. constructor TUnsortedCollection.Load ( VAR S : TStream ) ;
  44. begin
  45.    TCollection.Load ( S ) ;
  46. end ;
  47.    {===================================================================
  48.  
  49.    STORE
  50.  
  51.    ===================================================================}
  52. procedure TUnsortedCollection.Store ( VAR S : TStream ) ;
  53. begin
  54.    TCollection.Store ( S ) ;
  55. end ;
  56.    {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
  57.  
  58.    EMPTY
  59.  
  60.    |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  61.    {===================================================================
  62.  
  63.    MENUBAR
  64.  
  65.    ===================================================================}
  66. function EmptyMenuBar : PMenuBar ;
  67. var
  68.    R                         : TRect ;
  69. begin
  70.    Application^.GetExtent ( R ) ;
  71.    R.B.Y                     := R.A.Y + 1 ;
  72.    EmptyMenuBar              := New ( PMenuBar , Init ( R , NIL ) ) ;
  73. end ;
  74.    {===================================================================
  75.  
  76.    STATUSLINE
  77.  
  78.    ===================================================================}
  79. function EmptyStatusLine : PStatusLine ;
  80. var
  81.    R                         : TRect ;
  82. begin
  83.    Application^.GetExtent ( R ) ;
  84.    R.A.Y                     := R.B.Y - 1 ;
  85.    EmptyStatusLine           := New ( PStatusLine , Init ( R , NIL ) ) ;
  86. end ;
  87.    {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
  88.  
  89.    PSTRING
  90.  
  91.    |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  92.    {===================================================================
  93.  
  94.    SET - "PString" should always start out NIL.
  95.  
  96.    ===================================================================}
  97. procedure SetPStr ( VAR P : PString ; S : string ) ;
  98. begin
  99.    if P <> NIL then
  100.    begin
  101.       DisposeStr ( P ) ;
  102.       P                      := NIL ;
  103.    end ;
  104.    if S = '' then EXIT ;
  105.    P                         := NewStr ( S ) ;
  106. end ;
  107.    {===================================================================
  108.  
  109.    GET
  110.  
  111.    ===================================================================}
  112. function GetPStr ( P : PString ) : string ;
  113. begin
  114.    if P = NIL then
  115.       GetPStr                := ''
  116.    else
  117.       GetPStr                := P^ ;
  118. end ;
  119.    {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
  120.  
  121.    DISPOSE - release memory & set pointer to NIL
  122.  
  123.    |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  124.    {===================================================================
  125.  
  126.    COLLECTION
  127.  
  128.    ===================================================================}
  129. procedure DisposeCollection ( VAR C ) ;
  130. var
  131.    PtrRef                    : PCollection absolute C ;
  132. begin
  133.    if PtrRef = NIL then EXIT ;
  134.    Dispose ( PtrRef , Done ) ;
  135.    PtrRef                    := NIL ;
  136. end ;
  137.    {===================================================================
  138.  
  139.    VIEW
  140.  
  141.    ===================================================================}
  142. procedure DisposeView ( VAR P ) ;
  143. var
  144.    AView                     : PView ABSOLUTE P ;
  145. begin
  146.    if AView = NIL then EXIT ;
  147.    if AView^.Owner <> NIL then
  148.       AView^.Owner^.Delete ( AView ) ;
  149.    Dispose ( AView , Done ) ;
  150.    AView                     := NIL ;
  151. end ;
  152.    {===================================================================
  153.  
  154.    MENUBOX
  155.  
  156.    ===================================================================}
  157. procedure DisposeMenuBox ( VAR Box : PMenuBox ) ;
  158. begin
  159.    if Box = NIL then EXIT ;
  160.    if Box^.Owner <> NIL then
  161.       Box^.Owner^.Delete ( Box ) ;
  162.    DisposeMenu ( Box^.Menu ) ;
  163.    Dispose ( Box , Done ) ;
  164.    Box                       := NIL ;
  165. end ;
  166.    {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
  167.  
  168.    MENUBOX
  169.  
  170.    |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  171.    {===================================================================
  172.  
  173.    EXEC - Insert, get command and dispose.
  174.  
  175.    ===================================================================}
  176. procedure ExecMenu ( G : PGroup ; Box : PMenuBox ; VAR Event : TEvent ) ;
  177. begin
  178.    if Box = NIL then EXIT ;
  179.    if Box^.Owner = NIL then
  180.       G^.Insert ( Box ) ;
  181.    G^.ClearEvent ( Event ) ;
  182.    Event.Command             := G^.ExecView ( Box ) ;
  183.    DisposeMenuBox ( Box ) ;
  184.    if Event.Command = 0 then EXIT ;
  185.    Event.What                := evCommand ;
  186.    G^.PutEvent ( Event ) ;
  187. end ;
  188.